home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol136 / checksel.bas < prev    next >
Encoding:
BASIC Source File  |  1986-12-15  |  5.0 KB  |  100 lines
  1. 4000 COLOR 7,0: REM  ***************************************************************************************************
  2. 4010 REM                 'CHECKSEL' SUBROUTINE TO LIST SELECTED PAYEES OR TAX DEDUCTIBLE PAYEES
  3. 4020 REM  **************************************************************************************************************
  4. 4030 GOSUB 270  'OPEN PAYEE FILES
  5. 4040 PAGENO% = 0  'INITIALIZE TO ZERO
  6. 4050 LINECT% = 0  'INITIALIZE TO ZERO
  7. 4060 FOR I = 1 TO M4%
  8. 4070     CKNO%(I)=0      'INITIALIZE TO ZERO
  9. 4080 NEXT I
  10. 4090 COLOR 7,0: CLS
  11. 4100 PRINT "  Enter the Record Address for"
  12. 4110 PRINT "  those Payees you want printed"
  13. 4120 PRINT "  and enter 000 as the last address"
  14. 4130 PRINT "  or enter only 999 to print every"
  15. 4140 PRINT "  Tax Deductible Payee's records.":  BEEP
  16. 4150 I = 1: Y = CSRLIN: X = POS(0): X = X + 10   'ADJUST CURSOR COLUMN
  17. 4160 FIELDMAX% = 3: NUM.ONLY% = TRUE%: DEC.MINUS% = FALSE%: GOSUB 330
  18. 4170 KINT% = VAL(DATU$): LOCATE Y,X+1: COLOR 0,7: PRINT USING "###";KINT%: COLOR 7,0
  19. 4180 IF KINT% = 0 THEN GOTO 4210
  20. 4190 IF KINT% = 999 THEN GOTO 4290
  21. 4200 IF DATU$ = "" THEN CLOSE #1,#2: GOTO 260   'IF NULL INPUT, DO NOT RUN THIS JOB
  22. 4210 CKNO%(I) = KINT%
  23. 4220 IF CKNO%(I) = 0 THEN GOTO 4290
  24. 4230 I = I + 1
  25. 4240 Y = Y + 1   'ADJUST TO NEXT CURSOR ROW
  26. 4250 GOTO 4160
  27. 4260 REM  **************************************************************************************************************
  28. 4270 REM                     ENTRY POINT FOR LISTING OF ALL TAX DEDUCTIBLE PAYEE RECORDS
  29. 4280 REM  **************************************************************************************************************
  30. 4290 IF I = 1 THEN GOSUB 4740  'PRINT ALL TAX DEDUCTIBLE PAYEES
  31. 4300 GOSUB 4860 'HEADING PRINT ROUTINE
  32. 4310 FOR I = 1 TO M4%
  33. 4320     IF CKNO%(I) = 0 THEN GOTO 4680
  34. 4330     REC% = CKNO%(I)
  35. 4340     IF REC% > M1% THEN PRINT USING "  Invalid record number bypassed. ###";REC%: GOTO 4670
  36. 4350     PDTODATE# = 0
  37. 4360     GET #1,REC%: GET #2,REC%
  38. 4370     GOSUB 280  'MOVE FILE #2 TO ARRAY
  39. 4380     IF REC% = 1 THEN LSET G1$ = SPACE$(1)  'TO ALIGN AMOUNT ON BANK STATEMENT RECORD'S 1ST PRINT LINE
  40. 4390     LPRINT TAB(2);P2$;" ";REC%;TAB(16);A1$;TAB(48);G1$;SPC(5);
  41. 4400     J = 1  'COUNT NO. PRINT LINES FOR EACH PAYEE
  42. 4410     FOR K = 1 TO 8
  43. 4420         IF CHEK1%(K) = 0 AND K > 1 THEN GOTO 4490
  44. 4430         IF CHEK1%(K) = 0 AND K < 2 THEN GOTO 4480
  45. 4440         LPRINT USING "####";CHEK1%(K);
  46. 4450         LPRINT SPC(5);CHEK2$(K);SPC(4);CHEK3$(K);
  47. 4460         LPRINT USING "  #####,.##";CHEK4(K);
  48. 4470         IF CHEK2$(K)<>"V" THEN PDTODATE# = PDTODATE# + CHEK4(K)
  49. 4480         LINECT% = LINECT% + 1
  50. 4490         IF REC% = 1 THEN GOTO 4510  'MEMO DATA NOT ON BANK STATEMENT RECORD
  51. 4500         IF J = 1 THEN LPRINT TAB(90);D1$
  52. 4510         J = J + 1
  53. 4520         IF LINECT% < 61 THEN GOTO 4540
  54. 4530         GOSUB 4860  'PRINT REPORT HEADING SUBROUTINE
  55. 4540         LPRINT TAB(54);
  56. 4550     NEXT K
  57. 4560     REC% = CVI(L$)
  58. 4570     IF REC% = 0 THEN GOTO 4620
  59. 4580     GET #2,REC%
  60. 4590     LPRINT TAB(54);
  61. 4600     GOSUB 280  'MOVE FILE #2 TO ARRAY
  62. 4610     GOTO 4410
  63. 4620     LPRINT TAB(69);"TOTAL";TAB(77)
  64. 4630     LPRINT USING "######,.##";PDTODATE#
  65. 4640     LPRINT
  66. 4650     LINECT% = LINECT% + 2
  67. 4660     PDTODATE# = 0
  68. 4670 NEXT I
  69. 4680 LPRINT CHR$(18); CHR$(12)    'RETURN TO NORMAL PRINT & SKIP TO NEXT PAGE
  70. 4690 CLOSE #1,#2
  71. 4700 GOTO 260   'RETURN TO DISPLAY JOB CHOICES MENU
  72. 4710 REM  **************************************************************************************************************
  73. 4720 REM                      SUBROUTINE TO GET DISKETTE ADDRESS OF THE TAX DEDUCTIBLE PAYEES
  74. 4730 REM  **************************************************************************************************************
  75. 4740 I = 1
  76. 4750 FOR J = 2 TO M1%   'SKIP THE BANK STATEMENT RECORD AT ADDRESS 1
  77. 4760     GET #1,J
  78. 4770     IF ASC(F1$) = 255 THEN GOTO 4810
  79. 4780     IF G1$ = SPACE$(1) THEN GOTO 4810
  80. 4790     CKNO%(I) = J
  81. 4800     I = I + 1
  82. 4810 NEXT J
  83. 4820 RETURN
  84. 4830 REM  **************************************************************************************************************
  85. 4840 REM                        SUBROUTINE TO PRINT REPORT HEADING FOR SELECTED PAYEES
  86. 4850 REM  **************************************************************************************************************
  87. 4860 IF PAGENO% <> 0 THEN LPRINT CHR$(12)
  88. 4870 PAGENO% = PAGENO% + 1
  89. 4880 LPRINT PMODE$;CHR$(14);TAB(14);"SELECTED PAYEES AS OF ";
  90. 4890 LPRINT DATE$;SPC(6);"PAGE ";
  91. 4900 LPRINT USING "###";PAGENO%
  92. 4910 LPRINT: LPRINT TAB(48);"TAX   CHECK  STATUS  ISSUE"
  93. 4920 LPRINT TAB(6);"CODES";TAB(23);"PAYEE NAME";TAB(47);"CODE  NUMBER   CODE    DATE     AMOUNT            MEMO DATA"
  94. 4930 LPRINT
  95. 4940 LINECT% = 5
  96. 4950 RETURN
  97. 4960 REM  --------------------------------------------------------------------------------------------------------------
  98. 9000 GOTO 9000  'CHAIN MERGE AREA LAST STATEMENT
  99. ---------------------------------------------------------------------------
  100. 9000 GOTO 9000  'CHAIN MERGE AREA LAST